home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 …SCII & the Runetime Code / ADC Developer CD (1992-07) (''Butch ASCII And The Runtime Code'')_iso / Dev.CD 199207.iso / Development Platforms / LISP Related / MCL Utilities / Brightstar RAVE interface / RAVE-ACCESS.LISP < prev    next >
Encoding:
Text File  |  1990-09-14  |  11.5 KB  |  279 lines  |  [TEXT/CCL ]

  1. ;;; Copyright 1990 by Ruben Kleiman for Apple Computer, Inc.
  2. ;;; Advanced Technology Group
  3. ;;;
  4. ;;; interFACE Access From Macintosh Allegro Common Lisp
  5. ;;; NOTICE:  This code allows you to access the interFACE actors
  6. ;;;          from within Macintosh Allegro Common Lisp.  This file
  7. ;;;          contains ONLY the interface to interFACE, but not the
  8. ;;;          interFACE product.  To purchase a copy of interFACE,
  9. ;;;          call:
  10. ;;;                  Bright Star Technology, Inc.
  11. ;;;                  1450 114th Ave. SE Suite 200
  12. ;;;                  Bellevue, WA 98004
  13. ;;;                  Telephone: (206) 451-3697
  14. ;;;
  15. ;;;          Neither Ruben Kleiman, Apple Computer, Inc, nor
  16. ;;;          Bright Star Technologies, Inc. are to be held
  17. ;;;          responsible for any injury or property losses
  18. ;;;          resulting from the use of the software provided
  19. ;;;          in this file or for following the instructions
  20. ;;;          provided herein.  This software may not necessarily
  21. ;;;          be upgraded with future versions of interFACE.
  22. ;;;          No guarantees implicit or explicit are made about
  23. ;;;          the proper functioning of this software, nor about
  24. ;;;          the conformance of the specification provided in the
  25. ;;;          instructions below with the actual performance of the
  26. ;;;          software.
  27.  
  28.  
  29.  
  30. ;;; RAVE ACCESS FOR MACINTOSH ALLEGRO COMMON LISP
  31. ;;; ---------------------------------------------
  32.  
  33. ;;; INSTRUCTIONS:
  34. ;;;
  35. ;;; A. INSTALLATION
  36. ;;;   1. Buy your own copy of interFACE from Bright Star Technology, Inc.
  37. ;;;   2. Make sure that you put the RAVE folder immediately inside your
  38. ;;;      Macintosh Allegro Common Lisp folder (unless you change any
  39. ;;;      of the pathnames below).
  40. ;;;   3. Put the RAVE driver provided with the interFACE product inside your
  41. ;;;      System Folder and reboot.
  42. ;;;   4. Put the following into the RAVE folder:
  43. ;;;      (a)  Put inside the folder named ACTORS all the actors you care to use from the
  44. ;;;           interFACE product's "Actors I", "Actors II" and/or "Actors III"
  45. ;;;           folders.  (This folder is empty in the RAVE folder.)
  46. ;;;      (b)  The file RAVE.rsrc provided with the interFACE product.
  47. ;;;           You can find this file inside the RAVE Pascal Bindings
  48. ;;;           folder in the interFACE product.
  49. ;;;   5. The file ff.fasl is provided for your convenience.  It should
  50. ;;;      be available, however, with your version of Macintosh Allegro Common Lisp.
  51. ;;;      This file provides you with the Lisp/Foreign Function interface.
  52. ;;;      You should place this file in your LIBRARY folder.
  53. ;;;      It is meant to work with Macintohs Allegro CL Version 1.3.2. (See CAVEATS, below.)
  54. ;;;
  55. ;;; B. USING IT
  56. ;;;   1. Evaluate this file.
  57. ;;;   2. TEST-RAVE is a function that shows you how to access
  58. ;;;      the interFACE actors from Macintosh Allegro Common Lisp
  59. ;;;      through the interface provided in this file.  After evaluating
  60. ;;;      the buffer, evaluate the expressions at the commented
  61. ;;;      area at the end of this file.
  62. ;;;
  63. ;;; C. INTERFACE FUNCTION
  64. ;;;   The key interface function is called SendCommand.  SendCommand
  65. ;;;   takes just one argument:  a Lisp string representing the RAVE
  66. ;;;   command that you want to send.  For a complete list of RAVE
  67. ;;;   commands, see the interFACE User's Guide which is provided with
  68. ;;;   your interFACE product.
  69. ;;;
  70. ;;;   The function TEST-RAVE, below, is probably a
  71. ;;;   useful example of how to get an actor on a window and make it say
  72. ;;;   something.  TEST-RAVE takes two arguments:  a Lisp string naming
  73. ;;;   the actor that you want to show, and another Lisp string stating
  74. ;;;   something that you want the actor to say.
  75. ;;;
  76. ;;; D. CAVEATS
  77. ;;;   1.  This interface has been developed and used only on Macintosh
  78. ;;;       Allegro Common Lisp Version 1.3.1 or greater.  You can give
  79. ;;;       it a try with earlier versions.
  80. ;;;   2.  You can only use the {WINDOWLESS} mode when calling RAVE from
  81. ;;;       an application.  Bright Star Technology does not currently
  82. ;;;       support any other mode for application interfaces.
  83. ;;;   3.  The RAVE writer writes directly into your screen.  The TEST-RAVE
  84. ;;;       sample function in this file puts a window under the location
  85. ;;;       where RAVE does the drawing, but the drawing is not actually
  86. ;;;       directed at the window.
  87. ;;;   4.  On occassion, a "Master Pointer..." type error has been found.
  88. ;;;       This may be ignored.
  89.  
  90. ;;; Load foreign function linker and quickdraw (should be in your LIBRARY folder in MACL):
  91. (require :ff)
  92. (require :quickdraw)
  93.  
  94. ;;; Establish pathnames:
  95. (def-logical-pathname "RAVE" "CCL;RAVE:")
  96. (def-logical-pathname "ACTOR" "RAVE;ACTOR:")
  97. (def-logical-pathname "LIBRARIES" "RAVE;LIBRARIES:")
  98.  
  99. (ff-load "RAVE;CallRAVE.p.o"
  100.          :ffenv-name 'rave-access
  101.          :libraries '("Libraries;Interface.o"
  102.                       "Libraries;Runtime.o"
  103.                       "Libraries;PasLib.o"))
  104.  
  105. (defvar *rave-xcmd-loaded* nil)
  106.  
  107. (defun parse-actor-info (string)
  108.   (let ((s 0)
  109.         (e (length string))
  110.         ptr result)
  111.     (tagbody
  112.       cont
  113.       (setq ptr (search "," string :start2 s :end2 e))
  114.       (setq result (nconc result (list (subseq string s ptr))))
  115.       (or ptr (go done))
  116.       (setq s (1+ ptr))
  117.       (go cont)
  118.       done)
  119.     (values-list result)
  120.     ))
  121.  
  122. (defun P=>C (handle &aux (size (1- (_GetHandleSize :errchk :a0 handle :d0))))
  123.   (with-dereferenced-handles ((temp handle))
  124.     (dotimes (i size)
  125.       (%put-byte temp (%get-byte temp (1+ i)) i))
  126.     (%put-byte temp #\Null size)))
  127.  
  128. (defun C=>P (handle &aux (c -1) i)
  129.   (with-dereferenced-handles ((temp handle))
  130.     (loop
  131.       (if (= 0 (%get-byte temp (incf c)))  ;; NULL?
  132.         (return nil)))
  133.     (setq i (1- c))
  134.     (loop
  135.       (if (= i -1)
  136.         (return nil))
  137.       (%put-byte temp (%get-byte temp i) (1+ i))
  138.       (decf i))
  139.     (%put-byte temp c)))
  140.  
  141. (defun load-rave-xcmd ()
  142.   (or *rave-xcmd-loaded*
  143.       (if (eq (setq *rave-xcmd-loaded*
  144.                     (with-pstrs ((resfile (namestring (car (directory "RAVE;RAVE.RSRC")))))
  145.                       (_openresfile :ptr resfile :word)))
  146.               -1)
  147.         (error "Couldn't load RAVE resource file"))))
  148.  
  149. (defun load-actor-resfile (actor)
  150.   (if (eq (with-pstrs ((resfile (namestring (car (directory (concatenate 'string "ACTOR;" actor))))))
  151.             (_openresfile :ptr resfile :word))
  152.           -1)
  153.     (error "Couldn't load actor ~a's resource file" actor)))
  154.  
  155. ;;; This is a baroque way of defining a foreign function.
  156. (LET* ((*FAST-EVAL* T))
  157.   (EVAL '(MULTIPLE-VALUE-BIND (EntryPointer EnvPtr) (CCL::FF-LOOKUP "RAVE")
  158.            (DEFUN RAVECOMMAND (CommandString)
  159.              (CHECK-TYPE CommandString STRING)
  160.              (LET* ((EntryPoint (CCL::%CDR EntryPointer))
  161.                     (GlobalReg (CCL::FFENV-A5PTR EnvPtr)))
  162.                ;; CommandHandle DISPOSED BY RAVE DRIVER, PtrToHandle RETURNED TO RaveCommand CALLER
  163.                (LET ((CommandHandle (_NewHandle :errchk :D0 (1+ (LENGTH CommandString)) :A0))
  164.                      (PtrToHandle (_NewPtr :errchk :D0 4 :A0)))
  165.                  (PROGN
  166.                    (_HLock :errchk :d0 CommandHandle)
  167.                    (%put-ptr PtrToHandle CommandHandle)
  168.                    (CCL::%STORE-PSTR CommandString (%get-safe-ptr CommandHandle))
  169.                    (P=>C CommandHandle)
  170.                    (let ((result (FF-CALL EntryPoint :PTR PtrToHandle :A5 GlobalReg :WORD))
  171.                          temp)
  172.                      (if (handlep (setq temp (%get-safe-ptr PtrToHandle)))
  173.                        (C=>P temp))
  174.                      (values result PtrToHandle)))))))))
  175.  
  176. ;;; This is the workhorse function.  Use it to send any command that you find
  177. ;;; in your interFACE manual to the RAVE driver.
  178. (defun SendCommand (string)
  179.   (multiple-value-bind (result PtrToStringHandle)
  180.                        (RaveCommand string)
  181.     (if (= result 0)
  182.       (if (and (pointerp PtrToStringHandle)
  183.                (handlep (setq result (%get-safe-ptr PtrToStringHandle))))
  184.         (prog2 (_HLock :errchk :D0 result)
  185.                (%get-string (%get-safe-ptr result))
  186.                (_disposHandle :errchk :A0 result)
  187.                (_disposPtr :errchk :A0 PtrToStringHandle))
  188.         (error "RAVE driver error ~a" result)))))
  189.  
  190.  
  191.  
  192.  
  193.  
  194. #| Testing it:
  195.  
  196. ;;; EVALUATE THIS SAMPLE FUNCTION:
  197. (defun test-rave (actor-name &optional (sentence "Hi, there!"))
  198.   (declare (object-variable wptr))
  199.   (load-rave-xcmd)
  200.   (load-actor-resfile actor-name)
  201.   (let ((window_snap 0)
  202.         actor_name 
  203.         actor_width
  204.         actor_height
  205.         actor_depth
  206.         actor_size
  207.         actor_window
  208.         window_object
  209.         (actor_origin.h 0)
  210.         (actor_origin.v 0))
  211.     
  212.     (setq window_snap (SendCommand "{GET_SNAP_VALUE}"))  ;;; 8-bit boundaries must be observed
  213.  
  214.     (if (equal window_snap "FALSE")
  215.       (error "Get_Snap_Value command returned FALSE")
  216.       (setq window_snap (read-from-string window_snap)))
  217.     
  218.     (SendCommand (format nil "{ACTOR ~a}" actor-name))
  219.     
  220.     (multiple-value-setq (actor_name 
  221.                           actor_width
  222.                           actor_height
  223.                           actor_depth
  224.                           actor_size)
  225.                          (parse-actor-info (SendCommand "{ACTOR_INFO}")))
  226.     (setq actor_width (read-from-string actor_width)
  227.           actor_height (read-from-string actor_height)
  228.           actor_depth (read-from-string actor_depth)
  229.           actor_size (* (read-from-string actor_size) 1000))
  230.     
  231.     (setq actor_window (ask (setq window_object (oneof *window* :window-show nil
  232.                                                        :window-size (make-point actor_width
  233.                                                                                 actor_height)
  234.                                                        :window-type :single-edge-box
  235.                                                        )) wptr))
  236.     
  237.     (ask window_object (set-window-title actor-name))
  238.     (ask window_object (set-window-size (make-point (+ 40 actor_width) (+ 40 actor_height))))
  239.     
  240.     
  241.     (with-port actor_window
  242.       (ask window_object (set-origin actor_origin.h actor_origin.v))
  243.       (ask window_object (local-to-global actor_origin.h actor_origin.v))
  244.       (setq actor_origin.h (+ 8 (truncate (* actor_origin.h  window_snap) window_snap))
  245.             actor_origin.v (+ 8 (truncate (* actor_origin.v  window_snap) window_snap)))
  246.       (ask window_object (set-window-position actor_origin.h actor_origin.v))
  247.       (ask window_object (window-show))
  248.       (ask window_object (window-select))
  249.       (let ((move_actor_command (format nil "{USE ~a} {WINDOW_LAYER} {MOVE ~a,~a}"
  250.                                         actor_name actor_origin.h actor_origin.v)))
  251.         
  252.         (SendCommand move_actor_command)                  ;; MOVE ACTOR ONTO WINDOW
  253.         
  254.         (SendCommand (format nil "{SHOW ~a}" actor_name)) ;; SHOW ACTOR
  255.         
  256.         (SendCommand sentence)                            ;; MAKE ACTOR SAY SOMETHING
  257.         
  258.         (SendCommand "{EXPRESS A2 10} {EXPRESS A5}")                      ;; MAKE ACTOR SMILE
  259.         
  260.         (SendCommand (format nil "{HIDE ~a}" actor_name)) ;; HIDE ACTOR
  261.        
  262.         (SendCommand (format nil "{RETIRE ~a}" actor_name)) ;; RETIRE ACTOR
  263.         
  264.         ))
  265.     
  266.     (ask window_object (window-close))))
  267.  
  268. ;;; NOW EVALUATE THE FOLLOWING, ONE AT A TIME:
  269.  
  270. (SendCommand "{WINDOWLESS}")     ; STARTS THE RAVE DRIVER
  271.  
  272. (SendCommand "{SPEED 170}")      ; SETS THE SPEED OF SPEECH DRIVER
  273. (test-rave "Bill" "O K?")        ; GETS A WINDOW WITH THE BILL ACTOR SAYING "OK?"
  274. (test-rave "Spike" "Haaigh.  Yaah gott-a-smoke")  ; SPIKE SPEAKS
  275. (test-rave "Kitty" "I tought I saw, a bird!")  ; KITTY PONDERS...
  276.  
  277. (SendCommand "{INTERMISSION}")   ; TURNS OFF THE RAVE DRIVER
  278.  
  279. |#